home *** CD-ROM | disk | FTP | other *** search
Text File | 2001-05-22 | 63.2 KB | 1,644 lines |
- { *********************************************************************** }
- { }
- { Delphi / Kylix Cross-Platform Runtime Library }
- { System Unit }
- { }
- { Copyright (c) 1988-2001 Borland Software Corporation }
- { }
- { *********************************************************************** }
-
- unit System; { Predefined constants, types, procedures, }
- { and functions (such as True, Integer, or }
- { Writeln) do not have actual declarations.}
- { Instead they are built into the compiler }
- { and are treated as if they were declared }
- { at the beginning of the System unit. }
-
- {$H+,I-,R-,O+,W-}
- {$WARN SYMBOL_PLATFORM OFF}
-
- { L- should never be specified.
-
- The IDE needs to find DebugHook (through the C++
- compiler sometimes) for integrated debugging to
- function properly.
-
- ILINK will generate debug info for DebugHook if
- the object module has not been compiled with debug info.
-
- ILINK will not generate debug info for DebugHook if
- the object module has been compiled with debug info.
-
- Thus, the Pascal compiler must be responsible for
- generating the debug information for that symbol
- when a debug-enabled object file is produced.
- }
-
- interface
-
- (* You can use RTLVersion in $IF expressions to test the runtime library
- version level independently of the compiler version level.
- Example: {$IF RTLVersion >= 16.2} ... {$IFEND} *)
-
- const
- RTLVersion = 14.1;
-
- {$EXTERNALSYM CompilerVersion}
-
- (*
- const
- CompilerVersion = 0.0;
-
- CompilerVersion is assigned a value by the compiler when
- the system unit is compiled. It indicates the revision level of the
- compiler features / language syntax, which may advance independently of
- the RTLVersion. CompilerVersion can be tested in $IF expressions and
- should be used instead of testing for the VERxxx conditional define.
- Always test for greater than or less than a known revision level.
- It's a bad idea to test for a specific revision level.
- *)
-
-
- {$IFDEF DECLARE_GPL}
- (* The existence of the GPL symbol indicates that the System unit
- and the rest of the Delphi runtime library were compiled for use
- and distribution under the terms of the GNU General Public License (GPL).
- Under the terms of the GPL, all applications compiled with the
- GPL version of the Delphi runtime library must also be distributed
- under the terms of the GPL.
- For more information about the GNU GPL, see
- http://www.gnu.org/copyleft/gpl.html
-
- The GPL symbol does not exist in the Delphi runtime library
- purchased for commercial/proprietary software development.
-
- If your source code needs to know which licensing model it is being
- compiled into, you can use {$IF DECLARED(GPL)}...{$IFEND} to
- test for the existence of the GPL symbol. The value of the
- symbol itself is not significant. *)
-
- const
- GPL = True;
- {$ENDIF}
-
- { Variant type codes (wtypes.h) }
-
- varEmpty = $0000; { vt_empty }
- varNull = $0001; { vt_null }
- varSmallint = $0002; { vt_i2 }
- varInteger = $0003; { vt_i4 }
- varSingle = $0004; { vt_r4 }
- varDouble = $0005; { vt_r8 }
- varCurrency = $0006; { vt_cy }
- varDate = $0007; { vt_date }
- varOleStr = $0008; { vt_bstr }
- varDispatch = $0009; { vt_dispatch }
- varError = $000A; { vt_error }
- varBoolean = $000B; { vt_bool }
- varVariant = $000C; { vt_variant }
- varUnknown = $000D; { vt_unknown }
- //varDecimal = $000E; { vt_decimal } {UNSUPPORTED}
- { undefined $0f } {UNSUPPORTED}
- varShortInt = $0010; { vt_i1 }
- varByte = $0011; { vt_ui1 }
- varWord = $0012; { vt_ui2 }
- varLongWord = $0013; { vt_ui4 }
- varInt64 = $0014; { vt_i8 }
- //varWord64 = $0015; { vt_ui8 } {UNSUPPORTED}
-
- { if adding new items, update Variants' varLast, BaseTypeMap and OpTypeMap }
- varStrArg = $0048; { vt_clsid }
- varString = $0100; { Pascal string; not OLE compatible }
- varAny = $0101; { Corba any }
- varTypeMask = $0FFF;
- varArray = $2000;
- varByRef = $4000;
-
- { TVarRec.VType values }
-
- vtInteger = 0;
- vtBoolean = 1;
- vtChar = 2;
- vtExtended = 3;
- vtString = 4;
- vtPointer = 5;
- vtPChar = 6;
- vtObject = 7;
- vtClass = 8;
- vtWideChar = 9;
- vtPWideChar = 10;
- vtAnsiString = 11;
- vtCurrency = 12;
- vtVariant = 13;
- vtInterface = 14;
- vtWideString = 15;
- vtInt64 = 16;
-
- { Virtual method table entries }
-
- vmtSelfPtr = -76;
- vmtIntfTable = -72;
- vmtAutoTable = -68;
- vmtInitTable = -64;
- vmtTypeInfo = -60;
- vmtFieldTable = -56;
- vmtMethodTable = -52;
- vmtDynamicTable = -48;
- vmtClassName = -44;
- vmtInstanceSize = -40;
- vmtParent = -36;
- vmtSafeCallException = -32;
- vmtAfterConstruction = -28;
- vmtBeforeDestruction = -24;
- vmtDispatch = -20;
- vmtDefaultHandler = -16;
- vmtNewInstance = -12;
- vmtFreeInstance = -8;
- vmtDestroy = -4;
-
- vmtQueryInterface = 0;
- vmtAddRef = 4;
- vmtRelease = 8;
- vmtCreateObject = 12;
-
- type
-
- TObject = class;
-
- TClass = class of TObject;
-
- HRESULT = type Longint; { from WTYPES.H }
- {$EXTERNALSYM HRESULT}
-
- PGUID = ^TGUID;
- TGUID = packed record
- D1: LongWord;
- D2: Word;
- D3: Word;
- D4: array[0..7] of Byte;
- end;
-
- PInterfaceEntry = ^TInterfaceEntry;
- TInterfaceEntry = packed record
- IID: TGUID;
- VTable: Pointer;
- IOffset: Integer;
- ImplGetter: Integer;
- end;
-
- PInterfaceTable = ^TInterfaceTable;
- TInterfaceTable = packed record
- EntryCount: Integer;
- Entries: array[0..9999] of TInterfaceEntry;
- end;
-
- TMethod = record
- Code, Data: Pointer;
- end;
-
- { TObject.Dispatch accepts any data type as its Message parameter. The
- first 2 bytes of the data are taken as the message id to search for
- in the object's message methods. TDispatchMessage is an example of
- such a structure with a word field for the message id.
- }
- TDispatchMessage = record
- MsgID: Word;
- end;
-
- TObject = class
- constructor Create;
- procedure Free;
- class function InitInstance(Instance: Pointer): TObject;
- procedure CleanupInstance;
- function ClassType: TClass;
- class function ClassName: ShortString;
- class function ClassNameIs(const Name: string): Boolean;
- class function ClassParent: TClass;
- class function ClassInfo: Pointer;
- class function InstanceSize: Longint;
- class function InheritsFrom(AClass: TClass): Boolean;
- class function MethodAddress(const Name: ShortString): Pointer;
- class function MethodName(Address: Pointer): ShortString;
- function FieldAddress(const Name: ShortString): Pointer;
- function GetInterface(const IID: TGUID; out Obj): Boolean;
- class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
- class function GetInterfaceTable: PInterfaceTable;
- function SafeCallException(ExceptObject: TObject;
- ExceptAddr: Pointer): HResult; virtual;
- procedure AfterConstruction; virtual;
- procedure BeforeDestruction; virtual;
- procedure Dispatch(var Message); virtual;
- procedure DefaultHandler(var Message); virtual;
- class function NewInstance: TObject; virtual;
- procedure FreeInstance; virtual;
- destructor Destroy; virtual;
- end;
-
- const
- S_OK = 0; {$EXTERNALSYM S_OK}
- S_FALSE = $00000001; {$EXTERNALSYM S_FALSE}
- E_NOINTERFACE = HRESULT($80004002); {$EXTERNALSYM E_NOINTERFACE}
- E_UNEXPECTED = HRESULT($8000FFFF); {$EXTERNALSYM E_UNEXPECTED}
- E_NOTIMPL = HRESULT($80004001); {$EXTERNALSYM E_NOTIMPL}
-
- type
- IInterface = interface
- ['{00000000-0000-0000-C000-000000000046}']
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- end;
-
- (*$HPPEMIT '#define IInterface IUnknown' *)
-
- IUnknown = IInterface;
- {$M+}
- IInvokable = interface(IInterface)
- end;
- {$M-}
-
- IDispatch = interface(IUnknown)
- ['{00020400-0000-0000-C000-000000000046}']
- function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
- function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
- function GetIDsOfNames(const IID: TGUID; Names: Pointer;
- NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
- function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
- Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
- end;
-
- {$EXTERNALSYM IUnknown}
- {$EXTERNALSYM IDispatch}
-
- { TInterfacedObject provides a threadsafe default implementation
- of IInterface. You should use TInterfaceObject as the base class
- of objects implementing interfaces. }
-
- TInterfacedObject = class(TObject, IInterface)
- protected
- FRefCount: Integer;
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- public
- procedure AfterConstruction; override;
- procedure BeforeDestruction; override;
- class function NewInstance: TObject; override;
- property RefCount: Integer;
- end;
-
- TInterfacedClass = class of TInterfacedObject;
-
- { TAggregatedObject and TContainedObject are suitable base
- classes for interfaced objects intended to be aggregated
- or contained in an outer controlling object. When using
- the "implements" syntax on an interface property in
- an outer object class declaration, use these types
- to implement the inner object.
-
- Interfaces implemented by aggregated objects on behalf of
- the controller should not be distinguishable from other
- interfaces provided by the controller. Aggregated objects
- must not maintain their own reference count - they must
- have the same lifetime as their controller. To achieve this,
- aggregated objects reflect the reference count methods
- to the controller.
-
- TAggregatedObject simply reflects QueryInterface calls to
- its controller. From such an aggregated object, one can
- obtain any interface that the controller supports, and
- only interfaces that the controller supports. This is
- useful for implementing a controller class that uses one
- or more internal objects to implement the interfaces declared
- on the controller class. Aggregation promotes implementation
- sharing across the object hierarchy.
-
- TAggregatedObject is what most aggregate objects should
- inherit from, especially when used in conjunction with
- the "implements" syntax. }
-
- TAggregatedObject = class(TObject)
- protected
- { IInterface }
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- public
- constructor Create(const Controller: IInterface);
- property Controller: IInterface;
- end;
-
- { TContainedObject is an aggregated object that isolates
- QueryInterface on the aggregate from the controller.
- TContainedObject will return only interfaces that the
- contained object itself implements, not interfaces
- that the controller implements. This is useful for
- implementing nodes that are attached to a controller and
- have the same lifetime as the controller, but whose
- interface identity is separate from the controller.
- You might do this if you don't want the consumers of
- an aggregated interface to have access to other interfaces
- implemented by the controller - forced encapsulation.
- This is a less common case than TAggregatedObject. }
-
- TContainedObject = class(TAggregatedObject, IInterface)
- protected
- { IInterface }
- function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
- end;
-
- PShortString = ^ShortString;
- PAnsiString = ^AnsiString;
- PWideString = ^WideString;
- PString = PAnsiString;
-
- UCS2Char = WideChar;
- PUCS2Char = PWideChar;
- UCS4Char = type LongWord;
- {$NODEFINE UCS4CHAR}
- PUCS4Char = ^UCS4Char;
- {$NODEFINE PUCS4CHAR}
- TUCS4CharArray = array [0..$effffff] of UCS4Char;
- PUCS4CharArray = ^TUCS4CharArray;
- UCS4String = array of UCS4Char;
- {$NODEFINE UCS4String}
-
- UTF8String = type string;
- PUTF8String = ^UTF8String;
- {$NODEFINE UTF8String}
- {$NODEFINE PUTF8String}
-
- IntegerArray = array[0..$effffff] of Integer;
- PIntegerArray = ^IntegerArray;
- PointerArray = array [0..512*1024*1024 - 2] of Pointer;
- PPointerArray = ^PointerArray;
- TBoundArray = array of Integer;
- TPCharArray = packed array[0..(MaxLongint div SizeOf(PChar))-1] of PChar;
- PPCharArray = ^TPCharArray;
-
- (*$HPPEMIT 'namespace System' *)
- (*$HPPEMIT '{' *)
- (*$HPPEMIT ' typedef int *PLongint;' *)
- (*$HPPEMIT ' typedef bool *PBoolean;' *)
- (*$HPPEMIT ' typedef PChar *PPChar;' *)
- (*$HPPEMIT ' typedef double *PDouble;' *)
- (*$HPPEMIT ' typedef wchar_t UCS4Char;' *)
- (*$HPPEMIT ' typedef wchar_t *PUCS4Char;' *)
- (*$HPPEMIT ' typedef DynamicArray<UCS4Char> UCS4String;' *)
- (*$HPPEMIT '}' *)
- PLongint = ^Longint;
- {$EXTERNALSYM PLongint}
- PInteger = ^Integer;
- PCardinal = ^Cardinal;
- PWord = ^Word;
- PSmallInt = ^SmallInt;
- PByte = ^Byte;
- PShortInt = ^ShortInt;
- PInt64 = ^Int64;
- PLongWord = ^LongWord;
- PSingle = ^Single;
- PDouble = ^Double;
- PDate = ^Double;
- PDispatch = ^IDispatch;
- PPDispatch = ^PDispatch;
- PError = ^LongWord;
- PWordBool = ^WordBool;
- PUnknown = ^IUnknown;
- PPUnknown = ^PUnknown;
- {$NODEFINE PByte}
- PPWideChar = ^PWideChar;
- PPChar = ^PChar;
- PPAnsiChar = PPChar;
- PExtended = ^Extended;
- PComp = ^Comp;
- PCurrency = ^Currency;
- PVariant = ^Variant;
- POleVariant = ^OleVariant;
- PPointer = ^Pointer;
- PBoolean = ^Boolean;
-
- TDateTime = type Double;
- PDateTime = ^TDateTime;
-
- THandle = LongWord;
-
- TVarArrayBound = packed record
- ElementCount: Integer;
- LowBound: Integer;
- end;
- TVarArrayBoundArray = array [0..0] of TVarArrayBound;
- PVarArrayBoundArray = ^TVarArrayBoundArray;
- TVarArrayCoorArray = array [0..0] of Integer;
- PVarArrayCoorArray = ^TVarArrayCoorArray;
-
- PVarArray = ^TVarArray;
- TVarArray = packed record
- DimCount: Word;
- Flags: Word;
- ElementSize: Integer;
- LockCount: Integer;
- Data: Pointer;
- Bounds: TVarArrayBoundArray;
- end;
-
- TVarType = Word;
- PVarData = ^TVarData;
- {$EXTERNALSYM PVarData}
- TVarData = packed record
- VType: TVarType;
- case Integer of
- 0: (Reserved1: Word;
- case Integer of
- 0: (Reserved2, Reserved3: Word;
- case Integer of
- varSmallInt: (VSmallInt: SmallInt);
- varInteger: (VInteger: Integer);
- varSingle: (VSingle: Single);
- varDouble: (VDouble: Double);
- varCurrency: (VCurrency: Currency);
- varDate: (VDate: TDateTime);
- varOleStr: (VOleStr: PWideChar);
- varDispatch: (VDispatch: Pointer);
- varError: (VError: LongWord);
- varBoolean: (VBoolean: WordBool);
- varUnknown: (VUnknown: Pointer);
- varShortInt: (VShortInt: ShortInt);
- varByte: (VByte: Byte);
- varWord: (VWord: Word);
- varLongWord: (VLongWord: LongWord);
- varInt64: (VInt64: Int64);
- varString: (VString: Pointer);
- varAny: (VAny: Pointer);
- varArray: (VArray: PVarArray);
- varByRef: (VPointer: Pointer);
- );
- 1: (VLongs: array[0..2] of LongInt);
- );
- 2: (VWords: array [0..6] of Word);
- 3: (VBytes: array [0..13] of Byte);
- end;
- {$EXTERNALSYM TVarData}
-
- type
- TVarOp = Integer;
-
- const
- opAdd = 0;
- opSubtract = 1;
- opMultiply = 2;
- opDivide = 3;
- opIntDivide = 4;
- opModulus = 5;
- opShiftLeft = 6;
- opShiftRight = 7;
- opAnd = 8;
- opOr = 9;
- opXor = 10;
- opCompare = 11;
- opNegate = 12;
- opNot = 13;
-
- opCmpEQ = 14;
- opCmpNE = 15;
- opCmpLT = 16;
- opCmpLE = 17;
- opCmpGT = 18;
- opCmpGE = 19;
-
- type
- { Dispatch call descriptor }
- PCallDesc = ^TCallDesc;
- TCallDesc = packed record
- CallType: Byte;
- ArgCount: Byte;
- NamedArgCount: Byte;
- ArgTypes: array[0..255] of Byte;
- end;
-
- PDispDesc = ^TDispDesc;
- TDispDesc = packed record
- DispID: Integer;
- ResType: Byte;
- CallDesc: TCallDesc;
- end;
-
- PVariantManager = ^TVariantManager;
- {$EXTERNALSYM PVariantManager}
- TVariantManager = record
- VarClear: procedure(var V : Variant);
- VarCopy: procedure(var Dest: Variant; const Source: Variant);
- VarCopyNoInd: procedure; // ARGS PLEASE!
- VarCast: procedure(var Dest: Variant; const Source: Variant; VarType: Integer);
- VarCastOle: procedure(var Dest: Variant; const Source: Variant; VarType: Integer);
-
- VarToInt: function(const V: Variant): Integer;
- VarToInt64: function(const V: Variant): Int64;
- VarToBool: function(const V: Variant): Boolean;
- VarToReal: function(const V: Variant): Extended;
- VarToCurr: function(const V: Variant): Currency;
- VarToPStr: procedure(var S; const V: Variant);
- VarToLStr: procedure(var S: string; const V: Variant);
- VarToWStr: procedure(var S: WideString; const V: Variant);
- VarToIntf: procedure(var Unknown: IInterface; const V: Variant);
- VarToDisp: procedure(var Dispatch: IDispatch; const V: Variant);
- VarToDynArray: procedure(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
-
- VarFromInt: procedure(var V: Variant; const Value, Range: Integer);
- VarFromInt64: procedure(var V: Variant; const Value: Int64);
- VarFromBool: procedure(var V: Variant; const Value: Boolean);
- VarFromReal: procedure; // var V: Variant; const Value: Real
- VarFromTDateTime: procedure; // var V: Variant; const Value: TDateTime
- VarFromCurr: procedure; // var V: Variant; const Value: Currency
- VarFromPStr: procedure(var V: Variant; const Value: ShortString);
- VarFromLStr: procedure(var V: Variant; const Value: string);
- VarFromWStr: procedure(var V: Variant; const Value: WideString);
- VarFromIntf: procedure(var V: Variant; const Value: IInterface);
- VarFromDisp: procedure(var V: Variant; const Value: IDispatch);
- VarFromDynArray: procedure(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
- OleVarFromPStr: procedure(var V: OleVariant; const Value: ShortString);
- OleVarFromLStr: procedure(var V: OleVariant; const Value: string);
- OleVarFromVar: procedure(var V: OleVariant; const Value: Variant);
- OleVarFromInt: procedure(var V: OleVariant; const Value, Range: Integer);
-
- VarOp: procedure(var Left: Variant; const Right: Variant; OpCode: TVarOp);
- VarCmp: procedure(const Left, Right: TVarData; const OpCode: TVarOp); { result is set in the flags }
- VarNeg: procedure(var V: Variant);
- VarNot: procedure(var V: Variant);
-
- DispInvoke: procedure(Dest: PVarData; const Source: TVarData;
- CallDesc: PCallDesc; Params: Pointer); cdecl;
- VarAddRef: procedure(var V: Variant);
-
- VarArrayRedim: procedure(var A : Variant; HighBound: Integer);
- VarArrayGet: function(var A: Variant; IndexCount: Integer;
- Indices: Integer): Variant; cdecl;
- VarArrayPut: procedure(var A: Variant; const Value: Variant;
- IndexCount: Integer; Indices: Integer); cdecl;
-
- WriteVariant: function(var T: Text; const V: Variant; Width: Integer): Pointer;
- Write0Variant: function(var T: Text; const V: Variant): Pointer;
- end;
- {$EXTERNALSYM TVariantManager}
-
- { Dynamic array support }
- PDynArrayTypeInfo = ^TDynArrayTypeInfo;
- {$EXTERNALSYM PDynArrayTypeInfo}
- TDynArrayTypeInfo = packed record
- kind: Byte;
- name: string[0];
- elSize: Longint;
- elType: ^PDynArrayTypeInfo;
- varType: Integer;
- end;
- {$EXTERNALSYM TDynArrayTypeInfo}
-
- PVarRec = ^TVarRec;
- TVarRec = record { do not pack this record; it is compiler-generated }
- case Byte of
- vtInteger: (VInteger: Integer; VType: Byte);
- vtBoolean: (VBoolean: Boolean);
- vtChar: (VChar: Char);
- vtExtended: (VExtended: PExtended);
- vtString: (VString: PShortString);
- vtPointer: (VPointer: Pointer);
- vtPChar: (VPChar: PChar);
- vtObject: (VObject: TObject);
- vtClass: (VClass: TClass);
- vtWideChar: (VWideChar: WideChar);
- vtPWideChar: (VPWideChar: PWideChar);
- vtAnsiString: (VAnsiString: Pointer);
- vtCurrency: (VCurrency: PCurrency);
- vtVariant: (VVariant: PVariant);
- vtInterface: (VInterface: Pointer);
- vtWideString: (VWideString: Pointer);
- vtInt64: (VInt64: PInt64);
- end;
-
- PMemoryManager = ^TMemoryManager;
- TMemoryManager = record
- GetMem: function(Size: Integer): Pointer;
- FreeMem: function(P: Pointer): Integer;
- ReallocMem: function(P: Pointer; Size: Integer): Pointer;
- end;
-
- THeapStatus = record
- TotalAddrSpace: Cardinal;
- TotalUncommitted: Cardinal;
- TotalCommitted: Cardinal;
- TotalAllocated: Cardinal;
- TotalFree: Cardinal;
- FreeSmall: Cardinal;
- FreeBig: Cardinal;
- Unused: Cardinal;
- Overhead: Cardinal;
- HeapErrorCode: Cardinal;
- end;
-
- {$IFDEF PC_MAPPED_EXCEPTIONS}
- PUnwinder = ^TUnwinder;
- TUnwinder = record
- RaiseException: function(Exc: Pointer): LongBool; cdecl;
- RegisterIPLookup: function(fn: Pointer; StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool; cdecl;
- UnregisterIPLookup: procedure(StartAddr: LongInt) cdecl;
- DelphiLookup: function(Addr: LongInt; Context: Pointer): Pointer; cdecl;
- ClosestHandler: function(Context: Pointer): LongWord; cdecl;
- end;
- {$ENDIF PC_MAPPED_EXCEPTIONS}
-
- PackageUnitEntry = packed record
- Init, FInit : Pointer;
- end;
-
- { Compiler generated table to be processed sequentially to init & finit all package units }
- { Init: 0..Max-1; Final: Last Initialized..0 }
- UnitEntryTable = array [0..9999999] of PackageUnitEntry;
- PUnitEntryTable = ^UnitEntryTable;
-
- PackageInfoTable = packed record
- UnitCount : Integer; { number of entries in UnitInfo array; always > 0 }
- UnitInfo : PUnitEntryTable;
- end;
-
- PackageInfo = ^PackageInfoTable;
-
- { Each package exports a '@GetPackageInfoTable' which can be used to retrieve }
- { the table which contains compiler generated information about the package DLL }
- GetPackageInfoTable = function : PackageInfo;
-
- {$IFDEF DEBUG_FUNCTIONS}
- { Inspector Query; implementation in GETMEM.INC; no need to conditionalize that }
- THeapBlock = record
- Start: Pointer;
- Size: Cardinal;
- end;
-
- THeapBlockArray = array of THeapBlock;
- TObjectArray = array of TObject;
-
- function GetHeapBlocks: THeapBlockArray;
- function FindObjects(AClass: TClass; FindDerived: Boolean): TObjectArray;
- { Inspector Query }
- {$ENDIF}
-
- {
- When an exception is thrown, the exception object that is thrown is destroyed
- automatically when the except clause which handles the exception is exited.
- There are some cases in which an application may wish to acquire the thrown
- object and keep it alive after the except clause is exited. For this purpose,
- we have added the AcquireExceptionObject and ReleaseExceptionObject functions.
- These functions maintain a reference count on the most current exception object,
- allowing applications to legitimately obtain references. If the reference count
- for an exception that is being thrown is positive when the except clause is exited,
- then the thrown object is not destroyed by the RTL, but assumed to be in control
- of the application. It is then the application's responsibility to destroy the
- thrown object. If the reference count is zero, then the RTL will destroy the
- thrown object when the except clause is exited.
- }
- function AcquireExceptionObject: Pointer;
- procedure ReleaseExceptionObject;
-
- {$IFDEF PC_MAPPED_EXCEPTIONS}
- procedure GetUnwinder(var Dest: TUnwinder);
- procedure SetUnwinder(const NewUnwinder: TUnwinder);
- function IsUnwinderSet: Boolean;
-
- //function SysRegisterIPLookup(ModuleHandle, StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool;
- {
- Do NOT call these functions. They are for internal use only:
- SysRegisterIPLookup
- SysUnregisterIPLookup
- BlockOSExceptions
- UnblockOSExceptions
- AreOSExceptionsBlocked
- }
- function SysRegisterIPLookup(StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool;
- procedure SysUnregisterIPLookup(StartAddr: LongInt);
- //function SysAddressIsInPCMap(Addr: LongInt): Boolean;
- function SysClosestDelphiHandler(Context: Pointer): LongWord;
- procedure BlockOSExceptions;
- procedure UnblockOSExceptions;
- function AreOSExceptionsBlocked: Boolean;
-
- {$ELSE}
- // These functions are not portable. Use AcquireExceptionObject above instead
- function RaiseList: Pointer; deprecated; { Stack of current exception objects }
- function SetRaiseList(NewPtr: Pointer): Pointer; deprecated; { returns previous value }
- {$ENDIF}
-
- function ExceptObject: TObject;
- function ExceptAddr: Pointer;
-
-
- procedure SetInOutRes(NewValue: Integer);
-
- type
- TAssertErrorProc = procedure (const Message, Filename: string;
- LineNumber: Integer; ErrorAddr: Pointer);
- TSafeCallErrorProc = procedure (ErrorCode: HResult; ErrorAddr: Pointer);
-
- {$IFDEF DEBUG}
- {
- This variable is just for debugging the exception handling system. See
- _DbgExcNotify for the usage.
- }
- var
- ExcNotificationProc : procedure ( NotificationKind: Integer;
- ExceptionObject: Pointer;
- ExceptionName: PShortString;
- ExceptionLocation: Pointer;
- HandlerAddr: Pointer) = nil;
- {$ENDIF}
-
- var
- DispCallByIDProc: Pointer;
- ExceptProc: Pointer; { Unhandled exception handler }
- ErrorProc: procedure (ErrorCode: Byte; ErrorAddr: Pointer); { Error handler procedure }
- {$IFDEF MSWINDOWS}
- ExceptClsProc: Pointer; { Map an OS Exception to a Delphi class reference }
- ExceptObjProc: Pointer; { Map an OS Exception to a Delphi class instance }
- RaiseExceptionProc: Pointer;
- RTLUnwindProc: Pointer;
- {$ENDIF}
- ExceptionClass: TClass; { Exception base class (must be Exception) }
- SafeCallErrorProc: TSafeCallErrorProc; { Safecall error handler }
- AssertErrorProc: TAssertErrorProc; { Assertion error handler }
- ExitProcessProc: procedure; { Hook to be called just before the process actually exits }
- AbstractErrorProc: procedure; { Abstract method error handler }
- HPrevInst: LongWord deprecated; { Handle of previous instance - HPrevInst cannot be tested for multiple instances in Win32}
- MainInstance: LongWord; { Handle of the main(.EXE) HInstance }
- MainThreadID: LongWord; { ThreadID of thread that module was initialized in }
- IsLibrary: Boolean; { True if module is a DLL }
- CmdShow: Integer platform; { CmdShow parameter for CreateWindow }
- CmdLine: PChar platform; { Command line pointer }
- InitProc: Pointer; { Last installed initialization procedure }
- ExitCode: Integer = 0; { Program result }
- ExitProc: Pointer; { Last installed exit procedure }
- ErrorAddr: Pointer = nil; { Address of run-time error }
- RandSeed: Longint = 0; { Base for random number generator }
- IsConsole: Boolean; { True if compiled as console app }
- IsMultiThread: Boolean; { True if more than one thread }
- FileMode: Byte = 2; { Standard mode for opening files }
- {$IFDEF LINUX}
- FileAccessRights: Integer platform; { Default access rights for opening files }
- ArgCount: Integer platform;
- ArgValues: PPChar platform;
- {$ENDIF}
- Test8086: Byte; { CPU family (minus one) See consts below }
- Test8087: Byte = 3; { assume 80387 FPU or OS supplied FPU emulation }
- TestFDIV: Shortint; { -1: Flawed Pentium, 0: Not determined, 1: Ok }
- Input: Text; { Standard input }
- Output: Text; { Standard output }
- ErrOutput: Text; { Standard error output }
- envp: PPChar platform;
-
- const
- CPUi386 = 2;
- CPUi486 = 3;
- CPUPentium = 4;
-
- var
- Default8087CW: Word = $1332;{ Default 8087 control word. FPU control
- register is set to this value.
- CAUTION: Setting this to an invalid value
- could cause unpredictable behavior. }
-
- HeapAllocFlags: Word platform = 2; { Heap allocation flags, gmem_Moveable }
- DebugHook: Byte platform = 0; { 1 to notify debugger of non-Delphi exceptions
- >1 to notify debugger of exception unwinding }
- JITEnable: Byte platform = 0; { 1 to call UnhandledExceptionFilter if the exception
- is not a Pascal exception.
- >1 to call UnhandledExceptionFilter for all exceptions }
- NoErrMsg: Boolean platform = False; { True causes the base RTL to not display the message box
- when a run-time error occurs }
- {$IFDEF LINUX}
- { CoreDumpEnabled = True will cause unhandled
- exceptions and runtime errors to raise a
- SIGABRT signal, which will cause the OS to
- coredump the process address space. This can
- be useful for postmortem debugging. }
- CoreDumpEnabled: Boolean platform = False;
- {$ENDIF}
-
- type
- (*$NODEFINE TTextLineBreakStyle*)
- TTextLineBreakStyle = (tlbsLF, tlbsCRLF);
-
- var { Text output line break handling. Default value for all text files }
- DefaultTextLineBreakStyle: TTextLineBreakStyle = {$IFDEF LINUX} tlbsLF {$ENDIF}
- {$IFDEF MSWINDOWS} tlbsCRLF {$ENDIF};
- const
- sLineBreak = {$IFDEF LINUX} #10 {$ENDIF} {$IFDEF MSWINDOWS} #13#10 {$ENDIF};
-
- type
- HRSRC = THandle;
- TResourceHandle = HRSRC; // make an opaque handle type
- HINST = THandle;
- HMODULE = HINST;
- HGLOBAL = THandle;
-
- {$IFDEF ELF}
- { ELF resources }
- function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: PChar): TResourceHandle;
- function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
- function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
- function LockResource(ResData: HGLOBAL): Pointer;
- function UnlockResource(ResData: HGLOBAL): LongBool;
- function FreeResource(ResData: HGLOBAL): LongBool;
- {$ENDIF}
-
- { Memory manager support }
-
- procedure GetMemoryManager(var MemMgr: TMemoryManager);
- procedure SetMemoryManager(const MemMgr: TMemoryManager);
- function IsMemoryManagerSet: Boolean;
-
- function SysGetMem(Size: Integer): Pointer;
- function SysFreeMem(P: Pointer): Integer;
- function SysReallocMem(P: Pointer; Size: Integer): Pointer;
-
- var
- AllocMemCount: Integer; { Number of allocated memory blocks }
- AllocMemSize: Integer; { Total size of allocated memory blocks }
-
- {$IFDEF MSWINDOWS}
- function GetHeapStatus: THeapStatus; platform;
- {$ENDIF}
-
- { Thread support }
- type
- TThreadFunc = function(Parameter: Pointer): Integer;
- {$IFDEF LINUX}
- TSize_T = Cardinal;
-
- TSchedParam = record
- sched_priority: Integer;
- end;
-
- pthread_attr_t = record
- __detachstate,
- __schedpolicy: Integer;
- __schedparam: TSchedParam;
- __inheritsched,
- __scope: Integer;
- __guardsize: TSize_T;
- __stackaddr_set: Integer;
- __stackaddr: Pointer;
- __stacksize: TSize_T;
- end;
- {$EXTERNALSYM pthread_attr_t}
- TThreadAttr = pthread_attr_t;
- PThreadAttr = ^TThreadAttr;
-
- TBeginThreadProc = function (Attribute: PThreadAttr;
- ThreadFunc: TThreadFunc; Parameter: Pointer;
- var ThreadId: Cardinal): Integer;
- TEndThreadProc = procedure(ExitCode: Integer);
-
- var
- BeginThreadProc: TBeginThreadProc = nil;
- EndThreadProc: TEndThreadProc = nil;
- {$ENDIF}
-
- {$IFDEF MSWINDOWS}
- function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;
- ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;
- var ThreadId: LongWord): Integer;
- {$ENDIF}
- {$IFDEF LINUX}
- function BeginThread(Attribute: PThreadAttr; ThreadFunc: TThreadFunc;
- Parameter: Pointer; var ThreadId: Cardinal): Integer;
-
- {$ENDIF}
- procedure EndThread(ExitCode: Integer);
-
- { Standard procedures and functions }
-
- const
- { File mode magic numbers }
-
- fmClosed = $D7B0;
- fmInput = $D7B1;
- fmOutput = $D7B2;
- fmInOut = $D7B3;
-
- { Text file flags }
- tfCRLF = $1; // Dos compatibility flag, for CR+LF line breaks and EOF checks
-
- type
- { Typed-file and untyped-file record }
-
- TFileRec = packed record (* must match the size the compiler generates: 332 bytes *)
- Handle: Integer;
- Mode: Word;
- Flags: Word;
- case Byte of
- 0: (RecSize: Cardinal); // files of record
- 1: (BufSize: Cardinal; // text files
- BufPos: Cardinal;
- BufEnd: Cardinal;
- BufPtr: PChar;
- OpenFunc: Pointer;
- InOutFunc: Pointer;
- FlushFunc: Pointer;
- CloseFunc: Pointer;
- UserData: array[1..32] of Byte;
- Name: array[0..259] of Char; );
- end;
-
- { Text file record structure used for Text files }
- PTextBuf = ^TTextBuf;
- TTextBuf = array[0..127] of Char;
- TTextRec = packed record (* must match the size the compiler generates: 460 bytes *)
- Handle: Integer; (* must overlay with TFileRec *)
- Mode: Word;
- Flags: Word;
- BufSize: Cardinal;
- BufPos: Cardinal;
- BufEnd: Cardinal;
- BufPtr: PChar;
- OpenFunc: Pointer;
- InOutFunc: Pointer;
- FlushFunc: Pointer;
- CloseFunc: Pointer;
- UserData: array[1..32] of Byte;
- Name: array[0..259] of Char;
- Buffer: TTextBuf;
- end;
-
- TTextIOFunc = function (var F: TTextRec): Integer;
- TFileIOFunc = function (var F: TFileRec): Integer;
-
- procedure SetLineBreakStyle(var T: Text; Style: TTextLineBreakStyle);
-
- procedure ChDir(const S: string); overload;
- procedure ChDir(P: PChar); overload;
- function Flush(var t: Text): Integer;
- procedure _LGetDir(D: Byte; var S: string);
- procedure _SGetDir(D: Byte; var S: ShortString);
- function IOResult: Integer;
- procedure MkDir(const S: string); overload;
- procedure MkDir(P: PChar); overload;
- procedure Move(const Source; var Dest; Count: Integer);
- function ParamCount: Integer;
- function ParamStr(Index: Integer): string;
- procedure Randomize;
- procedure RmDir(const S: string); overload;
- procedure RmDir(P: PChar); overload;
- function UpCase(Ch: Char): Char;
-
- { Control 8087 control word }
-
- procedure Set8087CW(NewCW: Word);
- function Get8087CW: Word;
-
- { Wide character support procedures and functions for C++ }
- { These functions should not be used in Delphi code!
- (conversion is implicit in Delphi code) }
-
- function WideCharToString(Source: PWideChar): string;
- function WideCharLenToString(Source: PWideChar; SourceLen: Integer): string;
- procedure WideCharToStrVar(Source: PWideChar; var Dest: string);
- procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer;
- var Dest: string);
- function StringToWideChar(const Source: string; Dest: PWideChar;
- DestSize: Integer): PWideChar;
-
- { PUCS4Chars returns a pointer to the UCS4 char data in the
- UCS4String array, or a pointer to a null char if UCS4String is empty }
-
- function PUCS4Chars(const S: UCS4String): PUCS4Char;
-
- { Widestring <-> UCS4 conversion }
-
- function WideStringToUCS4String(const S: WideString): UCS4String;
- function UCS4StringToWideString(const S: UCS4String): WideString;
-
- { PChar/PWideChar Unicode <-> UTF8 conversion }
-
- // UnicodeToUTF8(3):
- // UTF8ToUnicode(3):
- // Scans the source data to find the null terminator, up to MaxBytes
- // Dest must have MaxBytes available in Dest.
- // MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
- // Function result includes the null terminator.
-
- function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: Integer): Integer; overload; deprecated;
- function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer; overload; deprecated;
-
- // UnicodeToUtf8(4):
- // UTF8ToUnicode(4):
- // MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
- // Function result includes the null terminator.
- // Nulls in the source data are not considered terminators - SourceChars must be accurate
-
- function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; overload;
- function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; overload;
-
- { WideString <-> UTF8 conversion }
-
- function UTF8Encode(const WS: WideString): UTF8String;
- function UTF8Decode(const S: UTF8String): WideString;
-
- { Ansi <-> UTF8 conversion }
-
- function AnsiToUtf8(const S: string): UTF8String;
- function Utf8ToAnsi(const S: UTF8String): string;
-
- { OLE string support procedures and functions }
-
- function OleStrToString(Source: PWideChar): string;
- procedure OleStrToStrVar(Source: PWideChar; var Dest: string);
- function StringToOleStr(const Source: string): PWideChar;
-
- { Variant manager support procedures and functions }
-
- procedure GetVariantManager(var VarMgr: TVariantManager);
- procedure SetVariantManager(const VarMgr: TVariantManager);
- function IsVariantManagerSet: Boolean;
-
- { Variant support procedures and functions }
-
- procedure _VarClear(var V: Variant);
- procedure _VarCopy(var Dest: Variant; const Source: Variant);
- procedure _VarCopyNoInd;
- procedure _VarCast(var Dest: Variant; const Source: Variant; VarType: Integer);
- procedure _VarCastOle(var Dest: Variant; const Source: Variant; VarType: Integer);
- procedure _VarClr(var V: Variant);
-
- { Variant text streaming support }
-
- function _WriteVariant(var T: Text; const V: Variant; Width: Integer): Pointer;
- function _Write0Variant(var T: Text; const V: Variant): Pointer;
-
- { Variant math and conversion support }
-
- function _VarToInt(const V: Variant): Integer;
- function _VarToInt64(const V: Variant): Int64;
- function _VarToBool(const V: Variant): Boolean;
- function _VarToReal(const V: Variant): Extended;
- function _VarToCurr(const V: Variant): Currency;
- procedure _VarToPStr(var S; const V: Variant);
- procedure _VarToLStr(var S: string; const V: Variant);
- procedure _VarToWStr(var S: WideString; const V: Variant);
- procedure _VarToIntf(var Unknown: IInterface; const V: Variant);
- procedure _VarToDisp(var Dispatch: IDispatch; const V: Variant);
- procedure _VarToDynArray(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
-
- procedure _VarFromInt(var V: Variant; const Value, Range: Integer);
- procedure _VarFromInt64(var V: Variant; const Value: Int64);
- procedure _VarFromBool(var V: Variant; const Value: Boolean);
- procedure _VarFromReal; // var V: Variant; const Value: Real
- procedure _VarFromTDateTime; // var V: Variant; const Value: TDateTime
- procedure _VarFromCurr; // var V: Variant; const Value: Currency
- procedure _VarFromPStr(var V: Variant; const Value: ShortString);
- procedure _VarFromLStr(var V: Variant; const Value: string);
- procedure _VarFromWStr(var V: Variant; const Value: WideString);
- procedure _VarFromIntf(var V: Variant; const Value: IInterface);
- procedure _VarFromDisp(var V: Variant; const Value: IDispatch);
- procedure _VarFromDynArray(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
- procedure _OleVarFromPStr(var V: OleVariant; const Value: ShortString);
- procedure _OleVarFromLStr(var V: OleVariant; const Value: string);
- procedure _OleVarFromVar(var V: OleVariant; const Value: Variant);
- procedure _OleVarFromInt(var V: OleVariant; const Value, Range: Integer);
-
- procedure _VarAdd(var Left: Variant; const Right: Variant);
- procedure _VarSub(var Left: Variant; const Right: Variant);
- procedure _VarMul(var Left: Variant; const Right: Variant);
- procedure _VarDiv(var Left: Variant; const Right: Variant);
- procedure _VarMod(var Left: Variant; const Right: Variant);
- procedure _VarAnd(var Left: Variant; const Right: Variant);
- procedure _VarOr(var Left: Variant; const Right: Variant);
- procedure _VarXor(var Left: Variant; const Right: Variant);
- procedure _VarShl(var Left: Variant; const Right: Variant);
- procedure _VarShr(var Left: Variant; const Right: Variant);
- procedure _VarRDiv(var Left: Variant; const Right: Variant);
-
- procedure _VarCmpEQ(const Left, Right: Variant); // result is set in the flags
- procedure _VarCmpNE(const Left, Right: Variant); // result is set in the flags
- procedure _VarCmpLT(const Left, Right: Variant); // result is set in the flags
- procedure _VarCmpLE(const Left, Right: Variant); // result is set in the flags
- procedure _VarCmpGT(const Left, Right: Variant); // result is set in the flags
- procedure _VarCmpGE(const Left, Right: Variant); // result is set in the flags
-
- procedure _VarNeg(var V: Variant);
- procedure _VarNot(var V: Variant);
-
- { Variant dispatch and reference support }
-
- procedure _DispInvoke; cdecl; // Dest: PVarData; const Source: TVarData;
- // CallDesc: PCallDesc; Params: Pointer
- procedure _IntfDispCall; cdecl; // ARGS PLEASE!
- procedure _IntfVarCall; cdecl; // ARGS PLEASE!
- procedure _VarAddRef(var V: Variant);
-
- { Variant array support procedures and functions }
-
- procedure _VarArrayRedim(var A : Variant; HighBound: Integer);
- function _VarArrayGet(var A: Variant; IndexCount: Integer;
- Indices: Integer): Variant; cdecl;
- procedure _VarArrayPut(var A: Variant; const Value: Variant;
- IndexCount: Integer; Indices: Integer); cdecl;
-
- { Package/Module registration and unregistration }
-
- type
- PLibModule = ^TLibModule;
- TLibModule = record
- Next: PLibModule;
- Instance: LongWord;
- CodeInstance: LongWord;
- DataInstance: LongWord;
- ResInstance: LongWord;
- Reserved: Integer;
- {$IFDEF LINUX}
- InstanceVar: Pointer platform;
- GOT: LongWord platform;
- CodeSegStart: LongWord platform;
- CodeSegEnd: LongWord platform;
- InitTable: Pointer platform;
- {$ENDIF}
- end;
-
- TEnumModuleFunc = function (HInstance: Integer; Data: Pointer): Boolean;
- {$EXTERNALSYM TEnumModuleFunc}
- TEnumModuleFuncLW = function (HInstance: LongWord; Data: Pointer): Boolean;
- {$EXTERNALSYM TEnumModuleFuncLW}
- TModuleUnloadProc = procedure (HInstance: Integer);
- {$EXTERNALSYM TModuleUnloadProc}
- TModuleUnloadProcLW = procedure (HInstance: LongWord);
- {$EXTERNALSYM TModuleUnloadProcLW}
-
- PModuleUnloadRec = ^TModuleUnloadRec;
- TModuleUnloadRec = record
- Next: PModuleUnloadRec;
- Proc: TModuleUnloadProcLW;
- end;
-
- var
- LibModuleList: PLibModule = nil;
- ModuleUnloadList: PModuleUnloadRec = nil;
-
- procedure RegisterModule(LibModule: PLibModule);
- procedure UnregisterModule(LibModule: PLibModule);
- function FindHInstance(Address: Pointer): LongWord;
- function FindClassHInstance(ClassType: TClass): LongWord;
- function FindResourceHInstance(Instance: LongWord): LongWord;
- function LoadResourceModule(ModuleName: PChar; CheckOwner: Boolean = True): LongWord;
- procedure EnumModules(Func: TEnumModuleFunc; Data: Pointer); overload;
- procedure EnumResourceModules(Func: TEnumModuleFunc; Data: Pointer); overload;
- procedure EnumModules(Func: TEnumModuleFuncLW; Data: Pointer); overload;
- procedure EnumResourceModules(Func: TEnumModuleFuncLW; Data: Pointer); overload;
- procedure AddModuleUnloadProc(Proc: TModuleUnloadProc); overload;
- procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProc); overload;
- procedure AddModuleUnloadProc(Proc: TModuleUnloadProcLW); overload;
- procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProcLW); overload;
- {$IFDEF LINUX}
- { Given an HMODULE, this function will return its fully qualified name. There is
- no direct equivalent in Linux so this function provides that capability. }
- function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
- {$ENDIF}
-
- { ResString support function/record }
-
- type
- PResStringRec = ^TResStringRec;
- TResStringRec = packed record
- Module: ^Cardinal;
- Identifier: Integer;
- end;
-
- function LoadResString(ResStringRec: PResStringRec): string;
-
- { Procedures and functions that need compiler magic }
-
- procedure _COS;
- procedure _EXP;
- procedure _INT;
- procedure _SIN;
- procedure _FRAC;
- procedure _ROUND;
- procedure _TRUNC;
-
- procedure _AbstractError;
- procedure _Assert(const Message, Filename: AnsiString; LineNumber: Integer);
- function _Append(var t: TTextRec): Integer;
- function _Assign(var t: TTextRec; const S: String): Integer;
- function _BlockRead(var f: TFileRec; buffer: Pointer; recCnt: Longint; var recsRead: Longint): Longint;
- function _BlockWrite(var f: TFileRec; buffer: Pointer; recCnt: Longint; var recsWritten: Longint): Longint;
- function _Close(var t: TTextRec): Integer;
- procedure _PStrCat;
- procedure _PStrNCat;
- procedure _PStrCpy(Dest: PShortString; Source: PShortString);
- procedure _PStrNCpy(Dest: PShortString; Source: PShortString; MaxLen: Byte);
- function _EofFile(var f: TFileRec): Boolean;
- function _EofText(var t: TTextRec): Boolean;
- function _Eoln(var t: TTextRec): Boolean;
- procedure _Erase(var f: TFileRec);
- function _FilePos(var f: TFileRec): Longint;
- function _FileSize(var f: TFileRec): Longint;
- procedure _FillChar(var Dest; count: Integer; Value: Char);
- function _FreeMem(P: Pointer): Integer;
- function _GetMem(Size: Integer): Pointer;
- function _ReallocMem(var P: Pointer; NewSize: Integer): Pointer;
- procedure _Halt(Code: Integer);
- procedure _Halt0;
- procedure Mark; deprecated;
- procedure _PStrCmp;
- procedure _AStrCmp;
- procedure _RandInt;
- procedure _RandExt;
- function _ReadRec(var f: TFileRec; Buffer: Pointer): Integer;
- function _ReadChar(var t: TTextRec): Char;
- function _ReadLong(var t: TTextRec): Longint;
- procedure _ReadString(var t: TTextRec; s: PShortString; maxLen: Longint);
- procedure _ReadCString(var t: TTextRec; s: PChar; maxLen: Longint);
- procedure _ReadLString(var t: TTextRec; var s: AnsiString);
- procedure _ReadWString(var t: TTextRec; var s: WideString);
- procedure _ReadWCString(var t: TTextRec; s: PWideChar; maxBytes: Longint);
- function _ReadWChar(var t: TTextRec): WideChar;
- function _ReadExt(var t: TTextRec): Extended;
- procedure _ReadLn(var t: TTextRec);
- procedure _Rename(var f: TFileRec; newName: PChar);
- procedure Release; deprecated;
- function _ResetText(var t: TTextRec): Integer;
- function _ResetFile(var f: TFileRec; recSize: Longint): Integer;
- function _RewritText(var t: TTextRec): Integer;
- function _RewritFile(var f: TFileRec; recSize: Longint): Integer;
- procedure _RunError(errorCode: Byte);
- procedure _Run0Error;
- procedure _Seek(var f: TFileRec; recNum: Cardinal);
- function _SeekEof(var t: TTextRec): Boolean;
- function _SeekEoln(var t: TTextRec): Boolean;
- procedure _SetTextBuf(var t: TTextRec; p: Pointer; size: Longint);
- procedure _StrLong(val, width: Longint; s: PShortString);
- procedure _Str0Long(val: Longint; s: PShortString);
- procedure _Truncate(var f: TFileRec);
- function _ValLong(const s: String; var code: Integer): Longint;
- {$IFDEF LINUX}
- procedure _UnhandledException;
- {$ENDIF}
- function _WriteRec(var f: TFileRec; buffer: Pointer): Pointer;
- function _WriteChar(var t: TTextRec; c: Char; width: Integer): Pointer;
- function _Write0Char(var t: TTextRec; c: Char): Pointer;
- function _WriteBool(var t: TTextRec; val: Boolean; width: Longint): Pointer;
- function _Write0Bool(var t: TTextRec; val: Boolean): Pointer;
- function _WriteLong(var t: TTextRec; val, width: Longint): Pointer;
- function _Write0Long(var t: TTextRec; val: Longint): Pointer;
- function _WriteString(var t: TTextRec; const s: ShortString; width: Longint): Pointer;
- function _Write0String(var t: TTextRec; const s: ShortString): Pointer;
- function _WriteCString(var t: TTextRec; s: PChar; width: Longint): Pointer;
- function _Write0CString(var t: TTextRec; s: PChar): Pointer;
- function _Write0LString(var t: TTextRec; const s: AnsiString): Pointer;
- function _WriteLString(var t: TTextRec; const s: AnsiString; width: Longint): Pointer;
- function _Write0WString(var t: TTextRec; const s: WideString): Pointer;
- function _WriteWString(var t: TTextRec; const s: WideString; width: Longint): Pointer;
- function _WriteWCString(var t: TTextRec; s: PWideChar; width: Longint): Pointer;
- function _Write0WCString(var t: TTextRec; s: PWideChar): Pointer;
- function _WriteWChar(var t: TTextRec; c: WideChar; width: Integer): Pointer;
- function _Write0WChar(var t: TTextRec; c: WideChar): Pointer;
- procedure _Write2Ext;
- procedure _Write1Ext;
- procedure _Write0Ext;
- function _WriteLn(var t: TTextRec): Pointer;
-
- procedure __CToPasStr(Dest: PShortString; const Source: PChar);
- procedure __CLenToPasStr(Dest: PShortString; const Source: PChar; MaxLen: Integer);
- procedure __ArrayToPasStr(Dest: PShortString; const Source: PChar; Len: Integer);
- procedure __PasToCStr(const Source: PShortString; const Dest: PChar);
-
- procedure __IOTest;
- function _Flush(var t: TTextRec): Integer;
-
- procedure _SetElem;
- procedure _SetRange;
- procedure _SetEq;
- procedure _SetLe;
- procedure _SetIntersect;
- procedure _SetIntersect3; { BEG only }
- procedure _SetUnion;
- procedure _SetUnion3; { BEG only }
- procedure _SetSub;
- procedure _SetSub3; { BEG only }
- procedure _SetExpand;
-
- procedure _Str2Ext;
- procedure _Str0Ext;
- procedure _Str1Ext;
- procedure _ValExt;
- procedure _Pow10;
- procedure _Real2Ext;
- procedure _Ext2Real;
-
- procedure _ObjSetup;
- procedure _ObjCopy;
- procedure _Fail;
- procedure _BoundErr;
- procedure _IntOver;
-
- { Module initialization context. For internal use only. }
-
- type
- PInitContext = ^TInitContext;
- TInitContext = record
- OuterContext: PInitContext; { saved InitContext }
- {$IFNDEF PC_MAPPED_EXCEPTIONS}
- ExcFrame: Pointer; { bottom exc handler }
- {$ENDIF}
- InitTable: PackageInfo; { unit init info }
- InitCount: Integer; { how far we got }
- Module: PLibModule; { ptr to module desc }
- DLLSaveEBP: Pointer; { saved regs for DLLs }
- DLLSaveEBX: Pointer; { saved regs for DLLs }
- DLLSaveESI: Pointer; { saved regs for DLLs }
- DLLSaveEDI: Pointer; { saved regs for DLLs }
- {$IFDEF MSWINDOWS}
- ExitProcessTLS: procedure; { Shutdown for TLS }
- {$ENDIF}
- DLLInitState: Byte; { 0 = package, 1 = DLL shutdown, 2 = DLL startup }
- end platform;
-
- type
- TDLLProc = procedure (Reason: Integer);
- // TDLLProcEx provides the reserved param returned by WinNT
- TDLLProcEx = procedure (Reason: Integer; Reserved: Integer);
-
- {$IFDEF LINUX}
- procedure _StartExe(InitTable: PackageInfo; Module: PLibModule; Argc: Integer; Argv: Pointer);
- procedure _StartLib(Context: PInitContext; Module: PLibModule; DLLProc: TDLLProcEx);
- {$ENDIF}
- {$IFDEF MSWINDOWS}
- procedure _StartExe(InitTable: PackageInfo; Module: PLibModule);
- procedure _StartLib;
- {$ENDIF}
- procedure _PackageLoad(const Table : PackageInfo; Module: PLibModule);
- procedure _PackageUnload(const Table : PackageInfo; Module: PLibModule);
- procedure _InitResStrings;
- procedure _InitResStringImports;
- procedure _InitImports;
- {$IFDEF MSWINDOWS}
- procedure _InitWideStrings;
- {$ENDIF}
-
- function _ClassCreate(AClass: TClass; Alloc: Boolean): TObject;
- procedure _ClassDestroy(Instance: TObject);
- function _AfterConstruction(Instance: TObject): TObject;
- function _BeforeDestruction(Instance: TObject; OuterMost: ShortInt): TObject;
- function _IsClass(Child: TObject; Parent: TClass): Boolean;
- function _AsClass(Child: TObject; Parent: TClass): TObject;
-
- {$IFDEF PC_MAPPED_EXCEPTIONS}
- procedure _RaiseAtExcept;
- //procedure _DestroyException(Exc: PRaisedException);
- procedure _DestroyException;
- {$ENDIF}
- procedure _RaiseExcept;
- procedure _RaiseAgain;
- procedure _DoneExcept;
- {$IFNDEF PC_MAPPED_EXCEPTIONS}
- procedure _TryFinallyExit;
- {$ENDIF}
- procedure _HandleAnyException;
- procedure _HandleFinally;
- procedure _HandleOnException;
- {$IFDEF PC_MAPPED_EXCEPTIONS}
- procedure _HandleOnExceptionPIC;
- {$ENDIF}
- procedure _HandleAutoException;
- {$IFDEF PC_MAPPED_EXCEPTIONS}
- procedure _ClassHandleException;
- {$ENDIF}
-
- procedure _CallDynaInst;
- procedure _CallDynaClass;
- procedure _FindDynaInst;
- procedure _FindDynaClass;
-
- procedure _LStrClr(var S);
- procedure _LStrArrayClr(var StrArray; cnt: longint);
- procedure _LStrAsg(var dest; const source);
- procedure _LStrLAsg(var dest; const source);
- procedure _LStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
- procedure _LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
- procedure _LStrFromChar(var Dest: AnsiString; Source: AnsiChar);
- procedure _LStrFromWChar(var Dest: AnsiString; Source: WideChar);
- procedure _LStrFromPChar(var Dest: AnsiString; Source: PAnsiChar);
- procedure _LStrFromPWChar(var Dest: AnsiString; Source: PWideChar);
- procedure _LStrFromString(var Dest: AnsiString; const Source: ShortString);
- procedure _LStrFromArray(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
- procedure _LStrFromWArray(var Dest: AnsiString; Source: PWideChar; Length: Integer);
- procedure _LStrFromWStr(var Dest: AnsiString; const Source: WideString);
- procedure _LStrToString{(var Dest: ShortString; const Source: AnsiString; MaxLen: Integer)};
- function _LStrLen(const s: AnsiString): Longint;
- procedure _LStrCat{var dest: AnsiString; source: AnsiString};
- procedure _LStrCat3{var dest:AnsiString; source1: AnsiString; source2: AnsiString};
- procedure _LStrCatN{var dest:AnsiString; argCnt: Integer; ...};
- procedure _LStrCmp{left: AnsiString; right: AnsiString};
- function _LStrAddRef(var str): Pointer;
- function _LStrToPChar(const s: AnsiString): PChar;
- procedure _Copy{ s : ShortString; index, count : Integer ) : ShortString};
- procedure _Delete{ var s : openstring; index, count : Integer };
- procedure _Insert{ source : ShortString; var s : openstring; index : Integer };
- procedure _Pos{ substr : ShortString; s : ShortString ) : Integer};
- procedure _SetLength(s: PShortString; newLength: Byte);
- procedure _SetString(s: PShortString; buffer: PChar; len: Byte);
-
- procedure UniqueString(var str: AnsiString); overload;
- procedure UniqueString(var str: WideString); overload;
- procedure _UniqueStringA(var str: AnsiString);
- procedure _UniqueStringW(var str: WideString);
-
-
- procedure _LStrCopy { const s : AnsiString; index, count : Integer) : AnsiString};
- procedure _LStrDelete{ var s : AnsiString; index, count : Integer };
- procedure _LStrInsert{ const source : AnsiString; var s : AnsiString; index : Integer };
- procedure _LStrPos{ const substr : AnsiString; const s : AnsiString ) : Integer};
- procedure _LStrSetLength{ var str: AnsiString; newLength: Integer};
- procedure _LStrOfChar{ c: Char; count: Integer): AnsiString };
- function _NewAnsiString(length: Longint): Pointer; { for debugger purposes only }
- function _NewWideString(CharLength: Longint): Pointer;
-
- procedure _WStrClr(var S);
- procedure _WStrArrayClr(var StrArray; Count: Integer);
- procedure _WStrAsg(var Dest: WideString; const Source: WideString);
- procedure _WStrLAsg(var Dest: WideString; const Source: WideString);
- function _WStrToPWChar(const S: WideString): PWideChar;
- function _WStrLen(const S: WideString): Integer;
- procedure _WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
- procedure _WStrFromPWCharLen(var Dest: WideString; Source: PWideChar; CharLength: Integer);
- procedure _WStrFromChar(var Dest: WideString; Source: AnsiChar);
- procedure _WStrFromWChar(var Dest: WideString; Source: WideChar);
- procedure _WStrFromPChar(var Dest: WideString; Source: PAnsiChar);
- procedure _WStrFromPWChar(var Dest: WideString; Source: PWideChar);
- procedure _WStrFromString(var Dest: WideString; const Source: ShortString);
- procedure _WStrFromArray(var Dest: WideString; Source: PAnsiChar; Length: Integer);
- procedure _WStrFromWArray(var Dest: WideString; Source: PWideChar; Length: Integer);
- procedure _WStrFromLStr(var Dest: WideString; const Source: AnsiString);
- procedure _WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
- procedure _WStrCat(var Dest: WideString; const Source: WideString);
- procedure _WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
- procedure _WStrCatN{var dest:WideString; argCnt: Integer; ...};
- procedure _WStrCmp{left: WideString; right: WideString};
- function _WStrCopy(const S: WideString; Index, Count: Integer): WideString;
- procedure _WStrDelete(var S: WideString; Index, Count: Integer);
- procedure _WStrInsert(const Source: WideString; var Dest: WideString; Index: Integer);
- procedure _WStrPos{ const substr : WideString; const s : WideString ) : Integer};
- procedure _WStrSetLength(var S: WideString; NewLength: Integer);
- function _WStrOfWChar(Ch: WideChar; Count: Integer): WideString;
- function _WStrAddRef(var str: WideString): Pointer;
-
- procedure _Initialize(p: Pointer; typeInfo: Pointer);
- procedure _InitializeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
- procedure _InitializeRecord(p: Pointer; typeInfo: Pointer);
- procedure _Finalize(p: Pointer; typeInfo: Pointer);
- procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
- procedure _FinalizeRecord(P: Pointer; typeInfo: Pointer);
- procedure _AddRef;
- procedure _AddRefArray;
- procedure _AddRefRecord;
- procedure _CopyArray;
- procedure _CopyRecord;
- procedure _CopyObject;
-
- function _New(size: Longint; typeInfo: Pointer): Pointer;
- procedure _Dispose(p: Pointer; typeInfo: Pointer);
-
- { 64-bit Integer helper routines }
- procedure __llmul;
- procedure __lldiv;
- procedure __lludiv;
- procedure __llmod;
- procedure __llmulo;
- procedure __lldivo;
- procedure __llmodo;
- procedure __llumod;
- procedure __llshl;
- procedure __llushr;
- procedure _WriteInt64;
- procedure _Write0Int64;
- procedure _ReadInt64;
- function _StrInt64(val: Int64; width: Integer): ShortString;
- function _Str0Int64(val: Int64): ShortString;
- function _ValInt64(const s: AnsiString; var code: Integer): Int64;
-
- { Dynamic array helper functions }
-
- procedure _DynArrayHigh;
- procedure _DynArrayClear(var a: Pointer; typeInfo: Pointer);
- procedure _DynArrayLength;
- procedure _DynArraySetLength;
- procedure _DynArrayCopy(a: Pointer; typeInfo: Pointer; var Result: Pointer);
- procedure _DynArrayCopyRange(a: Pointer; typeInfo: Pointer; index, count : Integer; var Result: Pointer);
- procedure _DynArrayAsg;
- procedure _DynArrayAddRef;
-
- procedure DynArrayClear(var a: Pointer; typeInfo: Pointer);
- procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: Longint; lengthVec: PLongint);
- function DynArrayDim(typeInfo: PDynArrayTypeInfo): Integer;
- {$NODEFINE DynArrayDim}
-
- function _IntfClear(var Dest: IInterface): Pointer;
- procedure _IntfCopy(var Dest: IInterface; const Source: IInterface);
- procedure _IntfCast(var Dest: IInterface; const Source: IInterface; const IID: TGUID);
- procedure _IntfAddRef(const Dest: IInterface);
-
- {$IFDEF MSWINDOWS}
- procedure _FSafeDivide;
- procedure _FSafeDivideR;
- {$ENDIF}
-
- function _CheckAutoResult(ResultCode: HResult): HResult;
-
- procedure FPower10;
-
- procedure TextStart; deprecated;
-
- // Conversion utility routines for C++ convenience. Not for Delphi code.
- function CompToDouble(Value: Comp): Double; cdecl;
- procedure DoubleToComp(Value: Double; var Result: Comp); cdecl;
- function CompToCurrency(Value: Comp): Currency; cdecl;
- procedure CurrencyToComp(Value: Currency; var Result: Comp); cdecl;
-
- function GetMemory(Size: Integer): Pointer; cdecl;
- function FreeMemory(P: Pointer): Integer; cdecl;
- function ReallocMemory(P: Pointer; Size: Integer): Pointer; cdecl;
-
- { Internal runtime error codes }
-
- type
- TRuntimeError = (reNone, reOutOfMemory, reInvalidPtr, reDivByZero,
- reRangeError, reIntOverflow, reInvalidOp, reZeroDivide, reOverflow,
- reUnderflow, reInvalidCast, reAccessViolation, rePrivInstruction,
- reControlBreak, reStackOverflow,
- { reVar* used in Variants.pas }
- reVarTypeCast, reVarInvalidOp,
- reVarDispatch, reVarArrayCreate, reVarNotArray, reVarArrayBounds,
- reAssertionFailed,
- reExternalException, { not used here; in SysUtils }
- reIntfCastError, reSafeCallError);
- {$NODEFINE TRuntimeError}
-
- procedure Error(errorCode: TRuntimeError);
- {$NODEFINE Error}
-
- { GetLastError returns the last error reported by an OS API call. Calling
- this function usually resets the OS error state.
- }
-
- function GetLastError: Integer; {$IFDEF MSWINDOWS} stdcall; {$ENDIF}
- {$EXTERNALSYM GetLastError}
-
- { SetLastError writes to the thread local storage area read by GetLastError. }
-
- procedure SetLastError(ErrorCode: Integer); {$IFDEF MSWINDOWS} stdcall; {$ENDIF}
-
- {$IFDEF LINUX}
- { To improve performance, some RTL routines cache module handles and data
- derived from modules. If an application dynamically loads and unloads
- shared object libraries, packages, or resource packages, it is possible for
- the handle of the newly loaded module to match the handle of a recently
- unloaded module. The resource caches have no way to detect when this happens.
-
- To address this issue, the RTL maintains an internal counter that is
- incremented every time a module is loaded or unloaded using RTL functions
- (like LoadPackage). This provides a cache version level signature that
- can detect when modules have been cycled but have the same handle.
-
- If you load or unload modules "by hand" using dlopen or dlclose, you must call
- InvalidateModuleCache after each load or unload so that the RTL module handle
- caches will refresh themselves properly the next time they are used. This is
- especially important if you manually tinker with the LibModuleList list of
- loaded modules, or manually add or remove resource modules in the nodes
- of that list.
-
- ModuleCacheID returns the "current generation" or version number kept by
- the RTL. You can use this to implement your own refresh-on-next-use
- (passive) module handle caches as the RTL does. The value changes each
- time InvalidateModuleCache is called.
- }
-
- function ModuleCacheID: Cardinal;
- procedure InvalidateModuleCache;
- {$ENDIF}
-
- {$IFDEF LINUX}
- { When a process that is being debugged is stopped while it has the mouse
- pointer grabbed, there is no way for the debugger to release the grab on
- behalf of the process. The process needs to do it itself. To accomplish this,
- the debugger causes DbgUnlockX to execute whenever it detects the process
- might have the mouse grabbed. This method will call through DbgUnlockXProc
- which should be assigned by any library using X and locks the X pointer. This
- method should be chained, by storing of the previous instance and calling it
- when you are called, since there might be more than one display that needs
- to be unlocked. This method should call XUngrabPointer on the display that
- has the pointer grabbed.
- }
- var
- DbgUnlockXProc: procedure;
-
- procedure DbgUnlockX;
- {$ENDIF}
-
- (* =================================================================== *)
-
- implementation
-